home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / kewlpo1a / frmpong.frm (.txt) < prev    next >
Visual Basic Form  |  1999-10-21  |  13KB  |  389 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPong 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Pong! ----- 0 / 0"
  5.    ClientHeight    =   5415
  6.    ClientLeft      =   45
  7.    ClientTop       =   615
  8.    ClientWidth     =   5370
  9.    Icon            =   "FRMPONG.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   5415
  14.    ScaleWidth      =   5370
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.CommandButton cmdStart 
  18.       Caption         =   "&Start!"
  19.       BeginProperty Font 
  20.          Name            =   "MS Sans Serif"
  21.          Size            =   8.25
  22.          Charset         =   0
  23.          Weight          =   700
  24.          Underline       =   0   'False
  25.          Italic          =   0   'False
  26.          Strikethrough   =   0   'False
  27.       EndProperty
  28.       Height          =   615
  29.       Left            =   1560
  30.       TabIndex        =   0
  31.       Top             =   2040
  32.       Width           =   1815
  33.    End
  34.    Begin VB.Shape shpP2 
  35.       BackColor       =   &H00000000&
  36.       BackStyle       =   1  'Opaque
  37.       Height          =   135
  38.       Left            =   1680
  39.       Top             =   360
  40.       Width           =   1335
  41.    End
  42.    Begin VB.Shape shpP1 
  43.       BackColor       =   &H00000000&
  44.       BackStyle       =   1  'Opaque
  45.       Height          =   135
  46.       Left            =   1680
  47.       Top             =   5160
  48.       Width           =   1335
  49.    End
  50.    Begin VB.Shape shpBall 
  51.       BackColor       =   &H000000FF&
  52.       BackStyle       =   1  'Opaque
  53.       Height          =   135
  54.       Left            =   2400
  55.       Shape           =   3  'Circle
  56.       Top             =   2160
  57.       Visible         =   0   'False
  58.       Width           =   135
  59.    End
  60.    Begin VB.Menu mnuFile 
  61.       Caption         =   "&File"
  62.       Begin VB.Menu mnuFileStart 
  63.          Caption         =   "&Start!"
  64.          Shortcut        =   ^S
  65.       End
  66.       Begin VB.Menu mnuFilePause 
  67.          Caption         =   "&Pause"
  68.          Shortcut        =   ^P
  69.          Visible         =   0   'False
  70.       End
  71.       Begin VB.Menu mnuFileResume 
  72.          Caption         =   "&Resume"
  73.          Shortcut        =   ^R
  74.          Visible         =   0   'False
  75.       End
  76.       Begin VB.Menu mnuSepe 
  77.          Caption         =   "-"
  78.       End
  79.       Begin VB.Menu mnuFileExit 
  80.          Caption         =   "E&xit"
  81.          Shortcut        =   ^X
  82.       End
  83.    End
  84.    Begin VB.Menu mnuSettings 
  85.       Caption         =   "&Settings"
  86.       Begin VB.Menu mnuConfig 
  87.          Caption         =   "&Keyboard configurations"
  88.       End
  89.       Begin VB.Menu mnuSepe1 
  90.          Caption         =   "-"
  91.       End
  92.       Begin VB.Menu mnuSetRounds 
  93.          Caption         =   "&No. of Rounds"
  94.       End
  95.       Begin VB.Menu mnuSetBSpeed 
  96.          Caption         =   "&Ball Speed"
  97.       End
  98.       Begin VB.Menu mnuSetPSpeed 
  99.          Caption         =   "&Paddle Speed"
  100.       End
  101.       Begin VB.Menu mnuSetPLength 
  102.          Caption         =   "Paddle &Length"
  103.       End
  104.       Begin VB.Menu mnuSetBSize 
  105.          Caption         =   "Ball &Size"
  106.          Begin VB.Menu mnuSetBSizeS 
  107.             Caption         =   "&Small"
  108.             Checked         =   -1  'True
  109.          End
  110.          Begin VB.Menu mnuSetBSizeM 
  111.             Caption         =   "&Medium"
  112.          End
  113.          Begin VB.Menu mnuSetBSizeL 
  114.             Caption         =   "&Large"
  115.          End
  116.       End
  117.    End
  118.    Begin VB.Menu mnunCredits 
  119.       Caption         =   "&Credits"
  120.       Begin VB.Menu mnuCredits 
  121.          Caption         =   "&Credits"
  122.       End
  123.    End
  124. Attribute VB_Name = "frmPong"
  125. Attribute VB_GlobalNameSpace = False
  126. Attribute VB_Creatable = False
  127. Attribute VB_PredeclaredId = True
  128. Attribute VB_Exposed = False
  129. Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
  130. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  131. Dim mx As Integer
  132. Dim my As Integer
  133. Dim mSpeed As Integer
  134. Dim Temp1 As Integer
  135. Dim Temp2 As Integer
  136. Dim StartTime As Long
  137. Dim P1win As Integer
  138. Dim P2win As Integer
  139. Dim Rounds As Integer
  140. Dim BallSpeed As Integer
  141. Dim rcolor As Integer
  142. Dim RNum As Byte
  143. Dim PaddleSpeed As Integer
  144. Dim PaddleLength As Long
  145. Dim BallSize As Byte
  146. Dim YesOK As Boolean
  147. Private Sub cmdStart_Click()
  148.     mnuFileStart.Visible = False
  149.     mnuFilePause.Visible = True
  150.     Me.BorderStyle = 3
  151.     RNum = Int(Rnd * 7)
  152.     mSpeed = 120
  153.     If my < 0 Then
  154.         mx = -60
  155.         my = -60
  156.         shpBall.Top = shpP1.Top - 240
  157.     Else
  158.         mx = 60
  159.         my = 60
  160.         shpBall.Top = shpP2.Top + 240
  161.     End If
  162.     shpBall.BackColor = vbRed
  163.     shpBall.Left = Int(Rnd * (Me.Width - shpBall.Width))
  164.     cmdStart.Visible = False
  165.     shpBall.Visible = True
  166.     StartTime = GetCurrentTime
  167. goagain:
  168.     If YesOK = True Then
  169.         Do Until GetCurrentTime - StartTime >= BallSpeed
  170.             KeyD
  171.             DoEvents
  172.         Loop
  173.         StartTime = GetCurrentTime
  174.         If (shpBall.Left >= shpP1.Left And shpBall.Left <= shpP1.Left + shpP1.Width) Then
  175.             If (shpBall.Top + shpBall.Height) >= shpP1.Top And (shpBall.Top + shpBall.Height) <= shpP1.Top + shpP1.Height Then
  176.                 Beep
  177.                 my = -my
  178.                 If my < 0 Then my = my - 1 Else my = my + 1
  179.                 Temp1 = shpBall.Left + shpBall.Width / 2
  180.                 Temp2 = shpP1.Left + shpP1.Width / 2
  181.                 mx = Temp2 - Temp1
  182.                 If Temp1 <> shpP1.Left And Temp1 <> shpP1.Left + shpP1.Width Then
  183.                     mx = mx / 7 * 3
  184.                 End If
  185.             End If
  186.         End If
  187.         
  188.         If (shpBall.Left >= shpP2.Left And shpBall.Left <= shpP2.Left + shpP2.Width) Then
  189.             If shpBall.Top <= (shpP2.Top + shpP2.Height) And shpBall.Top >= shpP2.Top Then
  190.                 Beep
  191.                 my = -my
  192.                 If my < 0 Then my = my - 1 Else my = my + 1
  193.                 Temp1 = shpBall.Left + shpBall.Width / 2
  194.                 Temp2 = shpP2.Left + shpP2.Width / 2
  195.                 mx = Temp2 - Temp1
  196.                 If Temp1 <> shpP2.Left And Temp1 <> shpP2.Left + shpP2.Width Then
  197.                     mx = mx / 7 * 3
  198.                 End If
  199.             End If
  200.         End If
  201.         
  202.         If (shpBall.Left >= (Me.Width - shpBall.Width)) Or shpBall.Left <= 0 Then mx = -mx
  203.         
  204.         If (shpBall.Top >= (Me.Height - shpBall.Height)) Then
  205.             MsgBox "P2 gets a point!"
  206.             P2win = P2win + 1
  207.             Me.Caption = "Pong! ----- " + LTrim$(Str$(P1win)) + " / " + LTrim$(Str$(P2win))
  208.             cmdStart.Visible = True
  209.             If P2win = Rounds Then
  210.                 MsgBox "P2 wins!"
  211.                 Me.BorderStyle = 2
  212.                 Unload Me
  213.                 Exit Sub
  214.             End If
  215.             Me.BorderStyle = 2
  216.             Exit Sub
  217.         End If
  218.         
  219.         If shpBall.Top <= 0 Then
  220.             MsgBox "P1 gets a point!"
  221.             P1win = P1win + 1
  222.             Me.Caption = "Pong! ----- " + LTrim$(Str$(P1win)) + " / " + LTrim$(Str$(P2win))
  223.             cmdStart.Visible = True
  224.                 If P1win = Rounds Then
  225.                 MsgBox "P1 wins!"
  226.                 Me.BorderStyle = 2
  227.                 Unload Me
  228.                 Exit Sub
  229.             End If
  230.             Me.BorderStyle = 2
  231.             Exit Sub
  232.         End If
  233.         
  234.         shpBall.Left = shpBall.Left + mx
  235.         shpBall.Top = shpBall.Top + my
  236.         KeyD
  237.     End If
  238.     DoEvents
  239.     GoTo goagain
  240. End Sub
  241. Private Sub Form_Load()
  242.     On Error Resume Next
  243.     Randomize
  244.     If Int(Rnd * 2) = 1 Then
  245.         mx = -60
  246.         my = -60
  247.     Else
  248.         mx = 60
  249.         my = 60
  250.     End If
  251.     P1win = 0
  252.     P2win = 0
  253.     'Instructions
  254.     '''''''''''''
  255.     MsgBox "Welcome to PONG! Code original by " + MyName + "."
  256.     MsgBox "Player 1 controls the bottom paddle with the '" & KeyStr1(0) & "' and '" & KeyStr1(1) & "' buttons to move it left and right respectively." & Chr(13) & _
  257.            "Player 2 controls the top paddle with the '" & KeyStr2(0) & "' and '" & KeyStr2(1) & "' buttons to move it left and right respectively." & Chr(13) & _
  258.            vbTab & "[P.S. These keyboard configuratio